//=============================================================================
///	Stream
/**

Common Lisp's "write" function:
http://www.lispworks.com/documentation/HyperSpec/Body/f_wr_pr.htm#write

	:escape
		as "format" ~S		"string"
		as "format" ~A		string

*/
//=============================================================================

#include "sstream.h"
#include "smem.h"
#include "sstring.h"
#include "offsetof.h"
#include "seval.h"		// for push_stack, pop_stack
#include <string.h>
#include <assert.h>

#ifndef	FALSE
#define	FALSE	(0)
#define	TRUE	(1)
#endif


static const int strm_sexp_ofstbl[] = {
	offsetof(Stream, fn),
	-1,
};

static void strm_write(SExp s, SExp strm, int escape) {
	write_cstr("#<strm:", strm);
	write(s.ptr->stream.fn, strm, escape);
	write_cstr(">", strm);
}

//=============================================================================
// File Stream

typedef struct {
	Stream base;
	FILE* fp;
} FileStream;

static void fs_close(FileStream* strm) {
	if (strm->fp != NULL) {
		fclose(strm->fp);
		strm->fp = NULL;
	}
}
static int fs_getch(FileStream* strm) {
	int c = fgetc(strm->fp);
	++strm->base.colno;
	if (c == '\n') {
		++strm->base.lineno;
		strm->base.colno = 0;
	}
	return c;
}
static void fs_ungetch(FileStream* strm, int c) {
	if (c == '\n') {
		--strm->base.lineno;
	}
	ungetc(c, strm->fp);
}
static int fs_write(FileStream* strm, const char* str) {
	fprintf(strm->fp, "%s", str);
	return TRUE;
}

static struct StreamBaseVTbl fs_file_stream_vtbl = {
	(void (*)(Stream*))fs_close,
	(int (*)(Stream*))fs_getch,
	(void (*)(Stream*, int))fs_ungetch,
	(int (*)(Stream*, const char*))fs_write,
};

static STypeInfo fs_typeinfo = {
	tStream,	0,
	"stream",
	strm_sexp_ofstbl,
	NULL,
	NULL,
	strm_write,
	NULL,
	NULL,
};

SExp make_file_stream(FILE* fp, const char* fn) {
	FileStream* p = smalloc(sizeof(*p));
	SExp s = ptr2s(p);
	push_stack(s);
	p->base.typeinfo = &fs_typeinfo;
	p->base.vtbl = &fs_file_stream_vtbl;
	p->base.fn = gen_str(fn, -1);
	p->base.lineno = 1;
	p->base.colno = 0;
	p->fp = fp;
	pop_stack(1);
	return s;
}



//=============================================================================

typedef struct {
	Stream base;
	const char* str;
	const char* p;
} StrStream;

static void ss_close(StrStream* strm) {
}
static int ss_getch(StrStream* strm) {
	int c;
	if (strm->p != NULL) {
		c = *(unsigned char*)strm->p++;
		++strm->base.colno;
	} else {
		c = EOF;
	}
	switch (c) {
	case '\0':
		strm->p = NULL;
		c = EOF;
		break;
	case '\n':
		++strm->base.lineno;
		strm->base.colno = 0;
		break;
	}
	return c;
}
static void ss_ungetch(StrStream* strm, int c) {
	assert(strm->p > strm->str);
	if (c == '\n') {
		--strm->base.lineno;
	}
	--strm->p;
}
static int ss_write(StrStream* strm, const char* str) {
	int len2 = strlen(str);
	char* buf;
	if (strm->str != NULL) {
		int len1 = strlen(strm->str);
		buf = smalloc(len1 + len2 + 1);
		strcpy(buf, strm->str);
		strcpy(buf + len1, str);
	} else {
		buf = smalloc(len2 + 1);
		strcpy(buf, str);
	}
	// do free old buf?
	strm->str = buf;
	strm->p = buf;
	return TRUE;
}

static struct StreamBaseVTbl ss_file_stream_vtbl = {
	(void (*)(Stream*))ss_close,
	(int (*)(Stream*))ss_getch,
	(void (*)(Stream*, int))ss_ungetch,
	(int (*)(Stream*, const char*))ss_write,
};

static STypeInfo ss_typeinfo = {
	tStream,	0,
	"stream",
	strm_sexp_ofstbl,
	NULL,
	NULL,
	strm_write,
	NULL,
	NULL,
};

SExp make_str_stream(const char* str) {
	StrStream* p = smalloc(sizeof(*p));
	p->base.typeinfo = &ss_typeinfo;
	p->base.vtbl = &ss_file_stream_vtbl;
	p->base.fn = nil;
	p->base.lineno = 1;
	p->str = str;
	p->p = str;
	return ptr2s(p);
}


//=============================================================================

int close_stream(SExp strm) {
	SExp sstrm = type_check(strm, tStream);
	Stream* pstrm = &sstrm.ptr->stream;
	(pstrm->vtbl->close)(pstrm);
	return TRUE;
}

int write_cstr(const char* str, SExp strm) {
	Stream* p;
	strm = type_check(strm, tStream);
	p = &strm.ptr->stream;
	return (p->vtbl->write)(p, str);
}


void write(SExp s, SExp strm, int escape) {
	const STypeInfo* p = get_type_info(s);
	(p->write)(s, strm, escape);
}


SExp read_char(SExp strm) {
	Stream* p;
	int c;
	strm = type_check(strm, tStream);
	p = &strm.ptr->stream;
	c = (p->vtbl->getch)(p);
	if (c == EOF) {
		return nil;
	} else {
		return char2s(c);
	}
}

SExp read_line(SExp strm) {
	Stream* p;
	int c;
	strm = type_check(strm, tStream);
	p = &strm.ptr->stream;
	c = (p->vtbl->getch)(p);
	if (c == EOF) {
		return nil;
	} else {
		char buf[256], *q = buf;		// @fixme: release limited
		for (; c != '\n' && c != EOF; ) {
			*q++ = c;
			c = (p->vtbl->getch)(p);
		}
		assert(q < buf + sizeof(buf));
		*q = '\0';
		return gen_str(buf, q - buf);
	}
}


SExp read_all(SExp strm) {
	SExp s = gen_str("", -1);
	SExp line;
	while (line = read_line(strm), !nilp(line)) {
		s = concat(s, line);
	}
	return s;
}

int sgetch(SExp strm) {
	strm = type_check(strm, tStream);
	{
		Stream* p = &strm.ptr->stream;
		return (p->vtbl->getch)(p);
	}
}

void sungetch(int ch, SExp strm) {
	strm = type_check(strm, tStream);
	{
		Stream* p = &strm.ptr->stream;
		(p->vtbl->ungetch)(p, ch);
	}
}
